COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	entry
C00015 ENDMK
C⊗;
entry;
begin  "grafix"
  
  comment  August 2, 1978 .

  This module implements routines to handle graphics on the
  Tektronix terminal. Every attempt is made to provide routines
  that are device-independent.  The following is the prescription
  for producing displays. 
    clipinit  begindisplay  'display'  endisplay
  endcomment;

  require  "define.sai"  source!file;
  require  "gabbrv.sai"  source!file;

  integer  rbeg, cbeg;  ! Top left-hand corner of window to be
			displayed;
  integer  rend, cend;	! Bottom right-hand corner of window;
  integer  rwsz, cwsz;  ! Window size;
  integer  rowsz, colsz;	! Size of picture;
  integer  curr, curc;	! current position of cursor on the screen;
  integer  size;	! size defining the window;
  boolean  vectors;	! whether or not to draw st lines with 
			  arrow heads;
  real  arrowlength;	! length of the arrowheads;


  STRING  S;
  DEFINE  CLIPCHECK = "FALSE";

  internal  simple  procedure  resetwindow;
  ! Procedure to set the screen. Assumes correct size
    parameters in the variables rbeg, cbeg, rend, cend, and
    size.;

  vwindo(cbeg*1.0,size*1.33,-rend*1.0,size*1.0);

  internal  simple  boolean  procedure  rcok(integer r, c);
  ! Checks whether a point is within the window.;
  return(rbeg <= r <= rend and cbeg <= c <= cend);

  internal  simple  procedure  clipdsp(integer  r1, c1, r2, c2);
  begin  "clip"
  integer  cd1, cd2;
  real  theta, rrp, ccp, rrm, ccm;	! variables for displaying
					  arrow heads;
  integer  nswap;	! No of times swapping is done;
  
  ! Produces a clipped line inside the window. This same 
    implementation is given in 
    Newmann & Sproull, Principles of Interactive Computer Graphics,
    McGraw-Hill, 1973, p.124.;

    simple  integer  procedure  code(integer r, c);
    return(( if r < rbeg then '01 else (if r > rend then '10 else 0)) +
      (if c < cbeg then '100 else (if c > cend then '1000 else 0)));

    cd1 := code(r1,c1);  cd2 := code(r2,c2);  nswap := 0;
    IFC  CLIPCHECK  THENC
    PRINT("CODES",CD1," ",CD2,CRLF);
    s := INTTY;  ENDC
    while  not(cd1 = cd2 = 0)  do
    begin
      IFC  CLIPCHECK  THENC
      IF  CD1 LAND CD2  THEN
      PRINT(" NOT VISIBLE",R1," ",C1," ",R2," ",C2,CRLF);
      s := INTTY;  ENDC
      if  cd1 land cd2  then  return;
      if  cd1 = 0  then  
      begin
        cd1 swap cd2;  r1 swap r2;  c1 swap c2;  nswap := nswap + 1;
      end;
      if  cd1 land '1  then
      begin
        c1 := c1 + (c2-c1)*(rbeg-r1)/(r2-r1);  r1 := rbeg;
      end  else
      if  cd1 land '10  then
      begin
        c1 := c1 + (c2-c1)*(rend-r1)/(r2-r1);  r1 := rend;
      end  else
      if  cd1 land '100  then
      begin
        r1 :=  r1 + (r2-r1)*(cbeg-c1)/(c2-c1);  c1 := cbeg;
      end  else
      if  cd1 land '1000  then
      begin
        r1 :=  r1 + (r2-r1)*(cend-c1)/(c2-c1);  c1 := cend;
      end;
      cd1 := code(r1,c1);
    end;

    IFC  CLIPCHECK  THENC
    PRINT(" CLIPPED LINE",R1," ",C1," TO ",R2," ",C2,CRLF);
    s := INTTY;
    ELSEC
      movea(1.0*c1,-1.0*r1);  drawa(1.0*c2,-1.0*r2);
      if  vectors  then
      begin
        if  not even(nswap)  then
        begin
          r1 swap r2;  c1 swap c2;
        end;
        theta := myatan(c2-c1,r2-r1);
        rrp := cosd(theta+135) * arrowlength;
        ccp := sind(theta+135) * arrowlength;
        rrm := - ccp;  ccm := rrp;
        drawa(1.0*(c2+ccp),-1.0*(r2+rrp));
        movea(1.0*(c2+ccm),-1.0*(r2+rrm));
        drawa(1.0*c2,-1.0*r2);
      end;
    ENDC
  end  "clip" ;

  internal  sIMPLE PROCEDURE ARDSTR(STRING sTR);
    BEGIN
    INTEGER I,CHA;
    FOR I←1 sTEP 1 UNTIL LENGTH(STR) DO
	BEGIN CHA←STR[I FOR 1];
	IF CHA='12 THEN LINEF ELSE IF CHA='15 THEN CARTN
	    ELSE ANCHO(CHA);
	END;
    END;

  internal  simple  procedure  dcrlf;
  begin
  ! Produces an equivalent of carriage-return and line-feed for
    alphameric display.;
    curr := curr + 3;
    movea(1.0*curc,-1.0*curr);
  end;

  internal  simple  procedure  movecursor(integer r, c);
  begin
  ! Moves cursor on the screen to the designated point.;
    curr := r;  curc := c;  movea(1.0*c,-1.0*r);
  end;

  INTERnal  simple  procedure  legend(string pic);
  begin
  integer  sz;
  ! Procedure to produce a legend on the Tektronix terminal.
    The legend is produced in the upper right-hand corner of the
    screen.;

    sz := 100;  curr := 5;  curc := 76;
    vwindo(0.0,1.0*sz,-1.0*sz,1.0*sz);
    movecursor(curr,curc);  ardstr(pic);  dcrlf;  dcrlf;
    ardstr("top left corner: ");  dcrlf;  
    ardstr(cvs(rbeg)&" "&cvs(cbeg));  dcrlf;  dcrlf;
    ardstr("window: ");  dcrlf;
    ardstr(cvs(rwsz)&" X "&cvs(cwsz));  dcrlf;  dcrlf;
  end;

  internal  simple  procedure  linelegend(string s);
  begin
  ! Produces a single line of legend, whatever it may be.;
    ardstr(s);  dcrlf;
  end;

  simple  procedure  border;
  begin
  ! Bordering the picture on the terminal screen.;
  ! produces border on the terminal;
      movea(1.0*cbeg,-1.0*rbeg);
      drawa(1.0*cbeg,-1.0*rend);
      drawa(1.0*cend,-1.0*rend);
      drawa(1.0*cend,-1.0*rbeg);
      drawa(1.0*cbeg,-1.0*rbeg);
  end;

  internal  simple  procedure  cliptest;
  begin
  ! Procedure to test 
		procedure clipdsp
    defined above.;
  integer  r1, c1, r2, c2;
    iprmpt(" rbeg",rbeg);  iprmpt(" rend",rend);
    iprmpt(" cbeg",cbeg);  iprmpt(" cend",cend);
    do  begin
      iprmpt(" r1",r1);  iprmpt(" c1",c1);
      iprmpt(" r2",r2);  iprmpt(" c2",c2);
      clipdsp(r1,c1,r2,c2);
      print(r1," ",c1," ",r2," ",c2," ",crlf);
    end  until  false;
  end;

  internal  simple  procedure  clipinit(integer r, c);
  begin
  ! Initialising this module.;
    rowsz := r;  colsz := c;  rbeg := 1;  cbeg := 1;
    size := r;  if  c > size  then  size := c;
    rwsz := r;  cwsz := c;  rend := r;  cend := c;
    vectors := false;
  end;

  simple  procedure  graphicswindow;
  begin
    do  begin
      print(" specify window.",crlf);
      iprmpt(" row begin",rbeg);  iprmpt(" col begin",cbeg);
      rwsz := rowsz - rbeg + 1;  cwsz := colsz - cbeg+ 1;
      iprmpt(" no of rows",rwsz);  iprmpt(" no of cols",cwsz);
      rend := rbeg + rwsz - 1;  cend := cbeg + cwsz - 1;
    end  until  1 <= rbeg <= rowsz and 1 <= rend <= rowsz 
           and  1 <= cbeg <= colsz and 1 <= cend <= colsz;
    size := rwsz;  if  cwsz > rwsz  then  size := cwsz;
    arrowlength := size/128.0;
  end;

  simple  procedure  startdisplay;
  begin
  ! Make sure you set up the size parameters all right ;

    pctr(0);  initt(450);
    resetwindow;  border;
    movecursor(rbeg,rend);
  end;

  internal  simple  procedure  endisplay;
  begin
    linelegend(date);  linelegend(ttime);
    movecursor(rend,cend);
    endpct;
  end;

  internal  simple  procedure  dashedline(integer fr,fc,tr,tc);
  begin
  ! Given from and to coordinates, produces a dashed line.;
    movea(1.0*fc,-1.0*fr);  dasha(1.0*tr,-1.0*tc);
    curr := tr;  curc := tc;
  end;

  internal  simple  procedure  begindisplay;
  begin
    bprmpt(" Vectors ?",vectors);
    graphicswindow;  startdisplay;
  end;

  internal  simple  procedure  drawline(integer r, c);
  begin
  ! Draws a line from wherever the cursor is to the point 
    specified. Cursoris moved also;
    clipdsp(curr,curc,r,c);  curr := r;  curc := c;
  end;

  INTERnal  simple  procedure  dispid(integer id, r, c);
  begin
  ! Displays an integer at the given coordinates.;
    if  rcok(r,c)  then
    begin
      movecursor(r,c);  ardstr(cvs(id));
    end;
  end;

  internal  simple  procedure  clipoint(integer r,c);
  begin
  ! displays a point, if within the window.;
  if  rcok(r,c)  then  pointa(1.0*c,-1.0*r);
  end;

  internal  simple  procedure  getwindow(reference integer r1,c1,r2,c2);
  begin
  ! Returns the top left-hand and bottom right-hand corners of the
  current window;
    r1 := rbeg;  c1 := cbeg;  r2 := rend;  c2 := cend;
  end;

  internal  simple  procedure  drawvectors;
  vectors := true;

  internal  simple  procedure  novectors;
  vectors := false;

end  "grafix";